procedure CheckForStack;
begin
  if nPics=0 then begin
    PutMessage('This macro requires a stack.');
    exit;
  end;
  if nSlices=0 then begin
    PutMessage('This window is not a stack.');
    exit
  end;
end;



macro 'convolve    [0]';
var
r,w,h:integer;
scale:real;

begin
GetPicSize(w,h);
r:=h/10;
PutMessage('10% image height = ',r);
r:=GetNumber('Indicate diameter of filter in px:',r);
scale:=50./r;  {  !  Gauss63  approx diameter 50 }
SelectAll;
SetScaling('bilinear New Window');
ScaleandRotate(scale,scale,0.);
PutMessage('Select Gauss63x63super');
Convolve('Gauss');
scale:=1./scale;
SetScaling('bilinear New Window');
ScaleandRotate(scale,scale,0.);
end;


macro '(-' begin end;


macro 'calibrate to matrix%  [M]';
begin 
Calibrate('straight','%m',0,0,255,100);

end;


macro 'uncalibrate                [U]';
begin 
Calibrate('uncalibrated');

end;


macro '(-' begin end;



macro 'log transform 2  [1]';
var
  i,v:integer;
  scale,ix,vx,logfactor:real;
begin

PutMessage('converts matrix density to fractal dimension for cut-off ratio Lm = 1/2');

  logfactor:= 0.434294481903252;
  scale := 255/2;

  for i:=1 to 254 DO begin
    ix:= i*100/255;
    vx := -4.6439 + 3.3219 *ln(ix) * logfactor;
    v := 255-round(vx * scale);
    if v < 1 then v := 1;
    if v > 255 then v:=255;
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
ApplyLUT;
end;



macro 'log transform 4  [2]';
var
  i,v:integer;
  scale,ix,vx,logfactor:real;
begin

PutMessage('converts matrix density to fractal dimension for cut-off ratio Lm = 1/4');

  logfactor:= 0.434294481903252;
  scale := 255/2;

  for i:=1 to 254 DO begin
    ix:= i*100/255;
    vx := -1.3219 + 1.661*ln(ix) * logfactor;
    v := 255-round(vx * scale);
    if v < 1 then v := 1;
    if v > 255 then v:=255;
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
ApplyLUT;
end;

macro 'log transform 8  [3]';
var
  i,v:integer;
  scale,ix,vx,logfactor:real;
begin

  logfactor:= 0.434294481903252;
  scale := 255/2;

PutMessage('converts matrix density to fractal dimension for cut-off ratio Lm = 1/8');

  for i:=1 to 254 DO begin
    ix:= i*100/255;
    vx := -.21462 + 1.1073*ln(ix) * logfactor;
    v := 255-round(vx * scale);
    if v < 1 then v := 1;
    if v > 255 then v:=255;
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
ApplyLUT;
end;


macro 'log transform 16  [4]';
var
  i,v:integer;
  scale,ix,vx,logfactor:real;
begin

PutMessage('converts matrix density to fractal dimension for cut-off ratio Lm = 1/16');

  logfactor:= 0.434294481903252;
  scale := 255/2;

  for i:=1 to 254 DO begin
    ix:= i*100/255;
    vx := .33904 + .83048*ln(ix) * logfactor;
    v := 255-round(vx * scale);
    if v < 1 then v := 1;
    if v > 255 then v:=255;
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
ApplyLUT;
end;


macro 'log transform 32  [5]';
var
  i,v:integer;
  scale,ix,vx,logfactor:real;
begin

PutMessage('converts matrix density to fractal dimension for cut-off ratio Lm = 1/32');

  logfactor:= 0.434294481903252;
  scale := 255/2;

  for i:=1 to 254 DO begin
    ix:= i*100/255;
    vx := .67123 + .66439 *ln(ix) * logfactor;
    v := 255-round(vx * scale);
    if v < 1 then v := 1;
    if v > 255 then v:=255;
    RedLUT[i]:=v;
    GreenLUT[i]:=v;
    BlueLUT[i]:=v;
  end;
  UpdateLUT;
ApplyLUT;
end;


macro '(-' begin end;

macro 'stretch to 1.00-2.00   [E]';
var
i,k:integer;
begin 

PutMessage('stretches 127-254 to 0-254');
for i:=1 to 254 do begin
k:=-256+i*2;
if k < 0 then k:= 0;
    RedLUT[i]:=255-k;
    GreenLUT[i]:=255-k;
    BlueLUT[i]:=255-k;
end;

end;

macro '(-' begin end;

macro 'calibrate to D  0.00-2.00   [S]';
begin 
Calibrate('straight','D2d',2,0,252,2.00);

end;


macro 'calibrate to D  1.00-2.00   [T]';
begin   
Calibrate('straight','D2d',1,1.0,252,2.00);

end;


macro '(-' begin end;

macro 'red line at level                 [V]';
var
i,j,k,level:integer;
begin
level:=50;
level:=GetNumber('level (%) ',level);
level:=level*2.55;

    RedLUT[level]:=255;
    GreenLUT[level]:=0;
    BlueLUT[level]:=0;

end;

macro 'yellow strip at level           [W]';
var
i,j,k,level:integer;
begin
level:=50;
level:=GetNumber('lower level (%) ',level);
j:=level*2.55;
level:=GetNumber('upper level (%) ',level);
k:=level*2.55;

for i:=j to k do begin
    RedLUT[i]:=255;
    GreenLUT[i]:=255;
    BlueLUT[i]:=0;

end;
end;


macro 'clip to bounds                   [X]';
var
i,lower,upper:integer;
xl,xu:real;
begin

xl:=GetNumber('lower limit in % = ',0.0);
xu:=GetNumber('upper limit in % = ',100.0);
lower:=xl*2.55;
upper:=xu*2.55;

AddConstant(1);
  for i:=0 to lower DO begin
    RedLUT[i]:=255;
    GreenLUT[i]:=255;
    BlueLUT[i]:=255;
  end;
  for i:=upper to 255 DO begin
    RedLUT[i]:=255;
    GreenLUT[i]:=255;
    BlueLUT[i]:=255;
  end;
UpdateLUT;

end;

macro 'transform to 20 levels       [Y]';
var
i,j,k,level,klo,kup:integer;
begin


for k:=0 to 12 do begin
      RedLUT[k]:=255;
      GreenLUT[k]:=255;
      BlueLUT[k]:=255;
end;

for j:=1 to 18 do begin

level:=(j*255)/19;

klo:=(j-1)*230/18 + 12;
kup:=j*230/18 + 12;

    for k:=klo to kup do begin
      RedLUT[k]:=255-level;
      GreenLUT[k]:=255-level;
      BlueLUT[k]:=255-level;
    end;
end;

for k:=kup+1 to 255 do begin
      RedLUT[k]:=0;
      GreenLUT[k]:=0;
      BlueLUT[k]:=0;
end;

UpdateLut;
end;


macro 'colour stepping of matrix  [Z]';
var
  i,v,mlo,mup,step:integer;
  
BEGIN

mlo:=20;
mup:=55;
mlo:=GetNumber('lower matrix in %:',mlo);
mup:=GetNumber('upper matrix in %:',mup);
mlo:=mlo*2.55;
mup:=mup*2.55;

  for i:=1 to mlo DO begin
    RedLUT[i]:=255;
    GreenLUT[i]:=255;
    BlueLUT[i]:=255;
  end;

step:=(mup-mlo)/10;
mup:=mlo+step;

  for i:=mlo to mup DO begin
    RedLUT[i]:=200;
    GreenLUT[i]:=255;
    BlueLUT[i]:=200;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=150;
    GreenLUT[i]:=255;
    BlueLUT[i]:=150;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=50;
    GreenLUT[i]:=255;
    BlueLUT[i]:=50;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=40;
    GreenLUT[i]:=220;
    BlueLUT[i]:=0;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=50;
    GreenLUT[i]:=200;
    BlueLUT[i]:=0;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=50;
    GreenLUT[i]:=120;
    BlueLUT[i]:=0;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=50;
    GreenLUT[i]:=80;
    BlueLUT[i]:=10;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=60;
    GreenLUT[i]:=50;
    BlueLUT[i]:=0;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=100;
    GreenLUT[i]:=20;
    BlueLUT[i]:=0;
  end;

mlo:=mlo+step;
mup:=mlo+step;
  for i:=mlo to mup DO begin
    RedLUT[i]:=150;
    GreenLUT[i]:=0;
    BlueLUT[i]:=0;
  end;


  for i:=mup to 254 DO begin
    RedLUT[i]:=0;
    GreenLUT[i]:=0;
    BlueLUT[i]:=0;
  end;

  UpdateLUT;
end;


macro '(-' begin end;

macro 'Spectrum LUT       [6]';
begin
SetPalette('Spectrum',0);
end;

macro 'Rainbow LUT         [7]';
begin
SetPalette('Rainbow',0);
end;

macro 'Pseudocolor LUT   [8]';
begin
SetPalette('Pseudocolor',0);
end;

macro 'System LUT           [9]';
begin
SetPalette('System',0);
end;


macro '(-' begin end;


macro 'reset LUT    [R]';
begin
  ResetGrayMap;
end;



macro '(-' begin end;


macro 'make montage [G]';
var
  col,row,start,last,incr:integer;
  mag:real;
		
begin
CheckForStack;
col:=GetNumber('number of columns ',nSlices);
row:=GetNumber('number of rows ',nSlices);
start:=GetNumber('first slice ',1);
last:=GetNumber('last slice ',nSlices);
incr:=GetNumber('increment ',1);
mag:=GetNumber('magnification ',1.00);

MakeMontage(col,row,mag,start,last,incr,false,true);

end;

